home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Yerk / Supplement / Demo Folder / grDemo < prev    next >
Encoding:
Text File  |  1991-01-01  |  6.4 KB  |  179 lines  |  [TEXT/MACA]
  1. \ grdemo - source for Curves, a simple Neon application
  2. \ 11/04/84  CBD Version 1
  3. \ 12/21/84  cbd simplified design based on new control classes
  4. \  2/18/84  cbd final for release 1.0
  5.  
  6. \ Define a class of special vertical scroll bars that 
  7. \ always show digital values for their thumb settings.
  8. :CLASS VSCtl  <Super vScroll
  9.  
  10.     Rect    readOut     \ visible rect around readout value
  11.     Rect    viewReadOut \ view rect for readout number is inset by 4 pixels.
  12.  
  13.     \ update the digital readout of the thumb value 
  14.     :M  DISPLAY:  GetTopX: viewReadOut getBotY: viewReadOut 1- gotoxy
  15.             -curs clear: viewReadOut  Get: super  3 .R  ;M
  16.  
  17.     \ redraw the readOut rect and display the value inside
  18.     :M  DRAW:  draw: readout  display: self   ;M
  19.  
  20.     \ ( val -- )  put new thumb value, draw the readout number
  21.     :M  PUT:  put: super  display: self  ;M
  22.  
  23.     \ Build new scroll bar - window must be created 1st
  24.     :M  NEW: { left top len  wind -- } left top len wind 
  25.             New: Super  1 tmode 9 tsize 1 tfont
  26.             \ calculate the coordinates for the readOut rectangles 
  27.             left 4-  top len + 4+ dup -> len        
  28.             left 20 + len 20 + put: readOut draw: readOut
  29.             get: readOut put: viewReadOut 3 3 inset: viewReadOut  ;M
  30.  
  31. ;CLASS
  32.  
  33. \ now, build three instances of class vSctl. These will be the
  34. \ three vertical scroll bars for Curves.
  35.    VSctl Vs1      \ three scroll bars for control of 
  36.    VSctl Vs2      \ graphics parameters by the user
  37.    VSctl Vs3       
  38.  
  39. \ assign constants to the window corners, so that we can change
  40. \ the size of the window and the length of the scroll bars will be
  41. \ adjusted automatically.  These constants relate to the global 
  42. \ coordinates of the Macintosh screen.
  43. 40  Value gwL    
  44. 60  Value gwT
  45. 470 Value gwR
  46. 290 Value gwB
  47. gwB gwT - 80 - Value vsLen  \ len of scroll bars 
  48.  
  49.  
  50. \ Define a subclass of CtlWind containing a drawing pane.
  51. \ The window will be a RoundDoc, draggable, non-growable.
  52. :CLASS grWind  <Super CtlWind 
  53.  
  54.     Rect    thePane \ this is where we'll draw the graphics
  55.                    
  56.     \ Create a new grWind with rounded corners and title passed by caller
  57.     :M  NEW: { taddr tlen -- }  gwL gwT gwR gwB put: tempRect
  58.             tempRect tAddr tLen rndWind
  59.             true False  New: super 
  60.             grayRgn true setDrag: self ;M     \ visible, no close box
  61.  
  62.     \ set defaults appropriate to this class
  63.     :M  CLASSINIT:   ClassInit: super    \ set window class defaults
  64.             4 15 320 220 put: thePane  ;M
  65.  
  66.     \ handle an update event for this window
  67.     :M  DRAW: set: self    draw: vs1 draw: vs2  draw: vs3   
  68.             (abs)  call BeginUpdate  (abs) call drawControls
  69.             clear: thePane draw: thePane
  70.             watchCurs                     \ show the watch cursor while drawing
  71.             clip: thePane  exec: draw    \ clip to the pane and draw
  72.             arrowCurs
  73.             (abs)  call EndUpdate 
  74.             clip: contRect      \ clip back to entire window
  75.             \ cause the scroll bars to draw their readouts
  76.     ;M
  77.  
  78.     \ Put a new draw cfa 
  79.     :M  SETDRAW:  Put: draw  ;M
  80.  
  81. ;CLASS
  82.  
  83. \ instantiate grWind to create the Curves demo window.
  84. grWind dwind
  85.  
  86. scon dTitle "Neon™ Curves"    \ title for dWind
  87.  
  88. \ set the current GrafPort to fWind so that we can see what's 
  89. \ going on during the compilation.
  90. set: fwind
  91.  
  92. \ ( -- p1 p2 p3 ) fetch the drawing parameters from the three scroll bars.
  93. : @dParms  get: vs1  get: vs2  get: vs3  ;
  94.  
  95. \ ( -- ) define the 4 draw: handlers, 1 for each type of drawing. 
  96. : Spiral  @dparms  PutRange: Bic    spiral: bic  ;
  97. : spin    @dparms  putRange: anna   spin: anna    ;
  98. : Lj      @dparms  putRange: bic    lj: bic   ;
  99. : dragon  @dparms   putRange: bic  home: bic 
  100.           get: vs1  dragon: bic  ;  \ dragon requires start val on stack 
  101.  
  102. \ store new parameter ranges for the three scroll bars.
  103. : !ranges  { max1 max2 max3 -- }  
  104.      1 max1 putRange: vs1  1 max2 putRange: vs2  
  105.      1 max3 putRange: vs3  ;
  106.      
  107. \ send the New: message to the window and scroll bars.
  108. \ this creates them within the Toolbox and displays them.
  109. : newObjs  close: fWind  dTitle New: dWind   
  110.       340 40 vsLen  dWind  new: vs1  
  111.       370 40 vsLen  dWind  new: vs2 
  112.       400 40 vsLen  dWind  new: vs3    ; 
  113.  
  114.  
  115. scon ab1 "Curves was written in Neon™"
  116. scon ab2 "by Charles B. Duff" 
  117. scon ab3 "of Kriya Systems, Inc."
  118.  
  119. : about  0 tfont 0 tmode 12 tsize
  120.     8 40 Gotoxy ab1 type 
  121.     cr ab2 type cr ab3 type
  122.     initFont  ;    
  123.  
  124. \ tell the two Pen objects where to center themselves 
  125. \ when they do a Home: operation. Because these values will be retained
  126. \ in the pen objects when we do a SAVE, they can be set
  127. \ at compile time.
  128. 150 120 center: bic
  129. 150 120 center: anna
  130.  
  131. \ Define the actions for the various control parts.
  132. \ each action handler executes a deferred get: on the object whose
  133. \ address is on the method stack. Since the handler was called from
  134. \ the Exec: method of a vScroll object, the scroll bar's address 
  135. \ will be on the top of the mstack.  The handler then modifies the 
  136. \ value of the thumb, and causes thePane in dWind to be redrawn
  137. \ be adding its area to the current region.
  138.  
  139. : doThumb   update: dWind  ;
  140. : doPgUp    get: myCtl 10 - put: myCtl update: dWind  ; 
  141. : doPgDn    get: myCtl 10 + put: myCtl update: dWind  ; 
  142. : doLnUp    get: myCtl 1-   put: myCtl update: dWind  ; 
  143. : doLnDn    get: myCtl 1+   put: myCtl update: dWind  ; 
  144.  
  145. 'c lj setdraw: dwind
  146.  
  147. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs1
  148. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs2
  149. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs3
  150.  
  151. \ define the menu for this application.  AppleMen is already there.
  152. 5 Menu Grafmen
  153.  
  154. \ Define the menu handler words. Each one sets a new handler
  155. \ for dWind's DRAW method, and then sets appropriate ranges and 
  156. \ titles for the scroll bars, and causes an update event.
  157. ( do Lissajous curves )
  158. : doLiss  'c lj setdraw: dWind  200 200 179 !ranges update: dWind ;
  159.  
  160. ( do Spirals )
  161. : doSpiral   'c spiral setDraw: dWind 10 20 179 !ranges  update: dWind  ;
  162.  
  163. ( do spinPolys )
  164. : doSpin  'c spin  setDraw: dWind  8 10 179 !ranges  update: dWind ;
  165.  
  166. ( do Dragon curves )
  167. : doDrag   'c dragon setDraw: dWind 11 12 179 !ranges update: dWind ;
  168.  
  169. ( set max reps in bic )
  170. : setReps 300 putMax: bic 100 putMax: anna ;
  171.  
  172. : sayonara  bye  ;
  173.  
  174. \ startup word for the turtle graphics demo
  175. : dStart  1000 20 gotoxy " dmenu.txt" getmtxt newobjs  
  176.     150 120 center: bic  150 120 center: anna  
  177.     setReps doLiss  -echo -curs 
  178.     BEGIN  key drop AGAIN    ;  \ just loop and listen to events
  179.